(*******************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which
typically will have the same name as this file except ending in
".nb" instead of ".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent
to using the Evaluate Initialization Cells menu command in the front
end.

DO NOT EDIT THIS FILE.  This entire file is regenerated
automatically each time the parent Notebook file is saved in the
Mathematica front end.  Any changes you make to this file will be
overwritten.
***********************************************************************)

















































































































































BeginPackage["BondGraphs`"];



Needs["DiscreteMath`GraphPlot`"]

(*Needs["Utilities`FilterOptions`"]*)



BondGraph::usage="BondGraph[{SE[a,10]\[RightVector]1[b],1[b]\[RightVector]\[ScriptCapitalI][c,10],1[b]\[RightVector]0[d],0[d]\[RightVector]C[e,1/1000],0[d]\[RightVector]1[h],SF[i,0]\[RightVector]1[h]}] represents a bond graph. The example given is that of a typical effort/inertia/compliance/ground system. Additional documentation is available in the source code for this package.";

Zero::usage="0[label] is a constant effort junction in a bond graph with a label. Note that the package presently does not use Zero, but uses 0. I originally wrote the package using 0, but this usage message apparently can't be associated with something that isn't a symbol.";

One::usage="1[label] is a constant flow junction in a bond graph with a label. Note that the package presently does not use One, but uses 1. I originally wrote the package using 1, but this usage message apparently can't be associated with something that isn't a symbol.";

C::usage="C[label,value] is a capacitance element in a bond graph with a label and a value.";

\[ScriptCapitalI]::usage="\[ScriptCapitalI][label,value] is an intertia element in a bond graph with a label and a value.";

R::usage="R[label,value] is a resistance element in a bond graph with a label and a value.";

SE::usage="SE[label,value] is an effort source in a bond graph with a label and a value.";

SF::usage="SF[label,value] is a flow source in a bond graph with a label and a value.";

RightVector::usage="lhs \[RightVector] rhs is a bond from junction lhs to junction rhs in a bond graph";

RightTeeVector::usage="lhs \[RightTeeVector] rhs is a bond from junction lhs to junction rhs that indicates flow to rhs is set by lhs and effort to lhs is set by rhs";

RightVectorBar::usage="lhs \[RightVectorBar] rhs is a bond from junction lhs to junction rhs that indicates effort to rhs is set by lhs and flow to lhs is set by rhs";

LeftVector::usage="lhs \[LeftVector] rhs is a bond from junction rhs to junction lhs in a bond graph. The package does not presently recognize this bond for input.";

LeftTeeVector::usage="lhs \[LeftTeeVector] rhs is a bond from junction rhs to junction lhs that indicates flow to lhs is set by rhs and effort to rhs is set by lhs. The package does not presently recognize this bond for input.";

LeftVectorBar::usage="lhs \[LeftVectorBar] rhs is a bond from junction rhs to junction lhs that indicates effort to lhs is set by rhs and flow to rhs is set by lhs. The package does not presently recognize this bond for input.";

Off[General::"spell1"]
BondGraphQ::usage="BondGraphQ[bgraph] yeilds True if bgraph is a bond graph and False otherwise.";\

On[General::"spell1"]

BondGraphJunctions::usage="BondGraphJunctions[bgraph] gives a list of the junctions and elements in bgraph in the order they appear.";

BondGraphCausality::usage="BondGraphCausality[bgraph] will return a bond graph with as many causal strokes as the algorithm can properly add.";

BondGraphEquations::usage="BondGraphStateEquations[bgraph,ivar] returns a system of differential algebraic equations based on bgraph with dependant variables named Effort[i,j][ivar], Flow[i,j][ivar], Momentum[i,j][ivar] and Displacement[i,j][ivar], where i and j indicate element/junction labels and ivar is the independant variable. The output is a literal translation of the bond graph into equations, without any assumptions.";

Effort::usage=
  "Effort[j1,j2][ivar] represents effort on the bond between the junctions j1 and j2. It is a function of the independant variable, ivar."



Flow::usage=
  "Flow[j1,j2][ivar] represents flow on the bond between the junctions j1 and j2. It is a function of the independant variable, ivar."



Momentum::usage=
  "Momentum[j1,j2][ivar] represents momentum on the bond between the junctions j1 and j2. It is a function of the independant variable, ivar."



Displacement::usage=
  "Displacement[j1,j2][ivar] represents displacement on the bond between the junctions j1 and j2. It is a function of the independant variable, ivar."



BondGraphStateEquations::usage="BondGraphStateEquations[bondgraph,ivar] returns a system of first order linear differential equations based on bgraph with dependant state variables named Momentum[i,j][ivar] and/or Displacement[i,j][ivar], where i and j indicate element/junction labels and ivar is the independant variable. This function drops equations of the Unequal type.";

BondGraphEquationsOutput::usage=
  "BondGraphEquationsOutput is an option to save evaluation time for BondGraphStateEquations by feeding it the output of BondGraphEquations (with the same arguments)"



BondGraphMatrix::usage="BondGraphMatrix[bgraph] replaces allowed bonds in favor of List while eliminating the outer BondGraph wrapper of bgraph";

BondGraphAdjacenceMatrix::usage="BondGraphAdjacenceMatrix[bgraph] gives the directed adjacence matrix of the bond graph bgraph, where bonds are indicated by the presence of a (type of) RightVector";

BondGraphAdjacenceTable::usage="BondGraphAdjacenceTable[bgraph] will pretty print BondGraphAdjacenceMatrix[bgraph]";

BondGraphUndirectedAdjacenceMatrix::usage="BondGraphAdjacenceMatrix[bgraph] gives the \"undirected\" adjacence matrix of the bond graph bgraph, where bonds are indicated by the presence of a (type of) RightVector or LeftVector";

BondGraphUndirectedAdjacenceTable::usage="BondGraphUndirectedAdjacenceTable[bgraph] will pretty print BondGraphUndirectedAdjacenceMatrix[bgraph]";

BondGraphUndirectedAdjacenceCountMatrix::usage="BondGraphAdjacenceCountMatrix[bgraph] gives the \"undirected\" adjacence matrix of the bond graph bgraph, where bonds are indicated by the presence of a 1";

BondGraphUndirectedAdjacenceCountTable::usage="BondGraphUndirectedAdjacenceCountTable[bgraph] will pretty print BondGraphUndirectedAdjacenceCountMatrix[bgraph]";

BondGraphPlot::usage="BondGraphPlot[bgraph] draws a bond graph with appropriate bonds depending on the causality of the graph. This function uses GraphPlot and GraphCoordinates from the DiscreteMath`GraphPlot package. You can set the Method option for GraphCoordinates in the options for this function. See the advanced documentation for GraphPlot online at http://documents.wolfram.com/mathematica/functions/AdvancedDocumentationGraphPlot for more information on the Method option. Other options include BondLengthRatio, FeatureLengthRatio and ImageSize.";

BondLengthRatio::usage="BondLengthRatio is an option for BondGraphPlot that determines the ratio of drawn bond length to junction separation distance.";

FeatureLengthRatio::usage="FeatureLengthRatio is an option for BondGraphPlot that determines the width of a bond relative to its' drawn length.";



Begin["`Private`"];



$AllowedBonds=RightVector|RightTeeVector|RightVectorBar;





BondGraphJunctionQ[junction_]:=
  MatchQ[junction,(C|\[ScriptCapitalI]|R|SE|SF)[b_,xp_]|(1|0)[b_]]



BondGraphJunctionListQ[junctions_]:=MatchQ[junctions,{__?BondGraphJunctionQ}]



Off[General::"spell1"]
BondGraphJunctionListsQ[junctionlists_]:=
  MatchQ[junctionlists,{__?BondGraphJunctionListQ}]
On[General::"spell1"]



Off[General::"spell1"]
Options[BondGraphBondQ]={AllowedBonds\[Rule]$AllowedBonds};
On[General::"spell1"]

BondGraphBondQ[bond_,opts___]:=
  MatchQ[bond,(AllowedBonds/.{opts}/.Options[BondGraphBondQ])[_?
        BondGraphJunctionQ,_?BondGraphJunctionQ]]



Options[BondGraphBondListQ]={AllowedBonds\[Rule]$AllowedBonds};

BondGraphBondListQ[bonds_,opts___]:=
  MatchQ[bonds,{PatternTest[__,
        BondGraphBondQ[#,
            AllowedBonds\[Rule](AllowedBonds/.{opts}/.Options[
                    BondGraphBondListQ])]&]}]



Options[BondGraphQ]={AllowedBonds\[Rule]$AllowedBonds};

BondGraphQ[bg_,opts___]:=
  MatchQ[bg,
    BondGraph[
      PatternTest[_,
        BondGraphBondListQ[#,
            AllowedBonds\[Rule](AllowedBonds/.{opts}/.Options[
                    BondGraphBondListQ])]&]]]



Options[BondGraphBondContainsJunctionQ]={AllowedBonds\[Rule]$AllowedBonds};

BondGraphBondContainsJunctionQ[bond_?BondGraphBondQ,
    junction_?BondGraphJunctionQ,opts___?OptionQ]:=
  And[MemberQ[bond,junction],
    BondGraphBondQ[bond,
      AllowedBonds\[Rule](AllowedBonds/.{opts}/.Options[
              BondGraphBondContainsJunctionQ])]]



BondGraphJunctions[bg_?BondGraphQ]:=
  Reap[Sow[1,Sequence@@@First[bg]],_,#1&][[2]]



BondGraphMatrix[bg_?BondGraphQ]:=List@@Apply[Sequence,Apply[List,bg,{2}],{1}]



Options[BondGraphAdjacenceMatrix]={JunctionList\[Rule]Automatic};
BondGraphAdjacenceMatrix[bg_?BondGraphQ,opts___]:=
  Module[{junctions=JunctionList/.{opts}/.Options[BondGraphAdjacenceMatrix],
      adj},If[junctions\[Equal]Automatic,junctions=BondGraphJunctions[bg]];
    adj=Table[0,{Length[junctions]},{Length[junctions]}];
    Scan[Function[Set[Part[adj,Sequence@@#],Head@#]],
      bg[[1]]/.MapIndexed[Rule[#1,First[#2]]&,junctions]];adj]



Options[BondGraphUndirectedAdjacenceMatrix]={JunctionList\[Rule]Automatic};
BondGraphUndirectedAdjacenceMatrix[bg_?BondGraphQ,opts___?OptionQ]:=
  Module[{junctions=
        JunctionList/.{opts}/.Options[BondGraphUndirectedAdjacenceMatrix],
      adj},If[junctions\[Equal]Automatic,junctions=BondGraphJunctions[bg]];
    adj=Table[0,{Length[junctions]},{Length[junctions]}];
    Scan[Function[Set[Part[adj,Sequence@@#],Head@#];
        Set[Part[adj,Sequence@@Reverse[#]],
          Head[#]/.{RightVector\[Rule]LeftVector,
              RightTeeVector\[Rule]LeftTeeVector,
              RightVectorBar\[Rule]LeftVectorBar}]],
      bg[[1]]/.MapIndexed[Rule[#1,First[#2]]&,junctions]];adj]



BondGraphUndirectedAdjacenceCountMatrix[bg_?BondGraphQ]:=
    BondGraphUndirectedAdjacenceMatrix[
        bg]/.{RightVector|RightTeeVector|RightVectorBar|LeftVector|
            LeftTeeVector|LeftVectorBar\[Rule]1};



BondGraphJunctionBonds[bg_?BondGraphQ,junction_?BondGraphJunctionQ]:=
  Module[{x},
    Cases[List@@Sequence@@@bg,x_/;BondGraphBondContainsJunctionQ[x,junction]]]



BondGraphNonJunctionBonds[bg_?BondGraphQ,junction_?BondGraphJunctionQ]:=
  Module[{x},
    DeleteCases[List@@Sequence@@@bg,
      x_/;BondGraphBondContainsJunctionQ[x,junction]]]



BondGraphJunctionPatternCausalityReplacements[bonds_?BondGraphBondListQ,
    junction_?BondGraphJunctionQ]:=
  Module[{x,blah1,blah2,nodepatternreplist},
    nodepatternreplist={{SE[__],
          RightVector[junction,blah2_]\[RuleDelayed]
            RightVectorBar[junction,blah2],
          RightVector[blah1_,junction]\[RuleDelayed]
            RightTeeVector[blah1,junction]},{SF[__],
          RightVector[junction,blah2_]\[RuleDelayed]
            RightTeeVector[junction,blah2],
          RightVector[blah1_,junction]\[RuleDelayed]
            RightVectorBar[blah1,junction]},{1[_],
          bondlist_List/;
              Or@@Map[MatchQ[#,
                      RightTeeVector[_,junction]|RightVectorBar[junction,_]]&,
                  bondlist]\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightTeeVector[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightVectorBar[blah1,junction]}]},{0[_],
          bondlist_List/;
              Or@@Map[MatchQ[#,
                      RightVectorBar[_,junction]|RightTeeVector[junction,_]]&,
                  bondlist]\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightVectorBar[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightTeeVector[blah1,junction]}]},{1[_],
          bondlist_List/;
              Length[Cases[bondlist,
                    x_/;BondGraphBondQ[x,
                        AllowedBonds\[Rule]
                          RightVector]]]\[Equal]1\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightVectorBar[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightTeeVector[blah1,junction]}]},{0[_],
          bondlist_List/;
              Length[Cases[bondlist,
                    x_/;BondGraphBondQ[x,
                        AllowedBonds\[Rule]
                          RightVector]]]\[Equal]1\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightTeeVector[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightVectorBar[blah1,junction]}]},{C[__],
          bondlist_List/;Length[bondlist]\[Equal]1\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightVectorBar[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightTeeVector[blah1,junction]}]},{\[ScriptCapitalI][__],
          bondlist_List/;Length[bondlist]\[Equal]1\[RuleDelayed]
            ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]
                  RightTeeVector[junction,blah2],
                RightVector[blah1_,junction]\[Rule]
                  RightVectorBar[blah1,junction]}]},{R[__],
          bondlist_List/;Length[bondlist]\[Equal]1\[RuleDelayed]ReplaceAll[
              bondlist,{RightVector[junction,blah2_]\[Rule]RightVectorBar[
                    junction,blah2],
                RightVector[blah1_,junction]\[Rule]RightTeeVector[blah1,
                    junction]}]}};
    bonds/.Flatten@
        Cases[nodepatternreplist,
          x_List/;MatchQ[junction,First[x]]\[RuleDelayed]Sequence@@Rest[x]]]



BondGraphCausalityHelperLevelNeg1[bg_?BondGraphQ,
    junction_?BondGraphJunctionQ]:=
  BondGraph[
    Join[BondGraphJunctionPatternCausalityReplacements[
        BondGraphJunctionBonds[bg,junction],junction],
      BondGraphNonJunctionBonds[bg,junction]]]



BondGraphCausalityHelperLevelNeg2[{bg_,junctions_}/;
      And[BondGraphQ[bg],BondGraphJunctionListQ[junctions]]]:={Fold[
      BondGraphCausalityHelperLevelNeg1,bg,junctions],junctions}



BondGraphCausalityHelperLevelNeg3[bg_?BondGraphQ,
    junctions_?BondGraphJunctionListQ]:=
  First@FixedPoint[BondGraphCausalityHelperLevelNeg2,{bg,junctions}]



BondGraphCausalityHelperLevelNeg4[bg_?BondGraphQ,
    junctionlists_?BondGraphJunctionListsQ]:=
  Catch[Fold[
      Function[If[
          BondGraphQ[#1,AllowedBonds\[Rule]RightTeeVector|RightVectorBar],
          Throw[#1],BondGraphCausalityHelperLevelNeg3[##]]],bg,junctionlists]]



BondGraphCausalityJunctionLists[bg_?BondGraphQ]:=
  Module[{sources,onesnzeros,secondorders,
      firstorders},{sources,onesnzeros,secondorders,firstorders}=
      Map[Cases[BondGraphJunctions[bg],#]&,{SE[__]|SF[__],1[_]|0[_],
          C[__]|\[ScriptCapitalI][__],R[__]}];{sources,onesnzeros,
      Sequence@@ReleaseHold[Hold[{#},onesnzeros]&/@secondorders],
      Sequence@@ReleaseHold[Hold[{#},onesnzeros]&/@firstorders]}]



BondGraphResort[unorderedbg_?BondGraphQ,desiredorderbg_?BondGraphQ]:=
  Module[{repdesiredorderbg=
        desiredorderbg/.{$AllowedBonds\[Rule]RightVector}},
    ReplacePart[desiredorderbg,unorderedbg,
      Sequence@@Transpose[
          MapIndexed[{First@Position[repdesiredorderbg,#1],#2}&,
              unorderedbg/.{$AllowedBonds\[Rule]RightVector},{2}][[1]]]]]



BondGraphCausality[bg_?BondGraphQ]:=
  BondGraphResort[
    BondGraphCausalityHelperLevelNeg4[bg,BondGraphCausalityJunctionLists[bg]],
    bg]



BondGraphJunctionPatternEqualityReplacements[bonds_?BondGraphBondListQ,
    junction_?BondGraphJunctionQ,ivar_Symbol]:=
  Module[{x,blah1,blah2,nodepatternreplist},
    nodepatternreplist={{SE[__],
          RightVectorBar[junction,blah2_]\[RuleDelayed]
            Equal[junction[[2]],Effort[junction[[1]],blah2[[1]]][ivar]],
          RightTeeVector[blah1_,junction]\[RuleDelayed]
            Equal[Effort[blah1[[1]],junction[[1]]][ivar],
              junction[[2]]]},{SF[__],
          RightTeeVector[junction,blah2_]\[RuleDelayed]
            Equal[junction[[2]],Flow[junction[[1]],blah2[[1]]][ivar]],
          RightVectorBar[blah1_,junction]\[RuleDelayed]
            Equal[Flow[blah1[[1]],junction[[1]]][ivar],junction[[2]]]},{1[_],
          bondlist_List\[RuleDelayed]{ReplaceAll[
                Equal[Plus@@bondlist,
                  0],{(RightTeeVector|RightVectorBar)[junction,
                      blah2_]\[RuleDelayed]-Effort[junction[[1]],blah2[[1]]][
                        ivar],(RightTeeVector|RightVectorBar)[blah1_,
                      junction]\[RuleDelayed]
                    Effort[blah1[[1]],junction[[1]]][ivar]}],
              ReplaceAll[
                Equal@@bondlist,{(RightTeeVector|RightVectorBar)[junction,
                      blah2_]\[RuleDelayed]
                    Flow[junction[[1]],blah2[[1]]][
                      ivar],(RightTeeVector|RightVectorBar)[blah1_,
                      junction]\[RuleDelayed]
                    Flow[blah1[[1]],junction[[1]]][ivar]}]}},{0[_],
          bondlist_List\[RuleDelayed]{ReplaceAll[
                Equal[Plus@@bondlist,
                  0],{(RightTeeVector|RightVectorBar)[junction,
                      blah2_]\[RuleDelayed]-Flow[junction[[1]],blah2[[1]]][
                        ivar],(RightTeeVector|RightVectorBar)[blah1_,
                      junction]\[RuleDelayed]
                    Flow[blah1[[1]],junction[[1]]][ivar]}],
              ReplaceAll[
                Equal@@bondlist,{(RightTeeVector|RightVectorBar)[junction,
                      blah2_]\[RuleDelayed]
                    Effort[junction[[1]],blah2[[1]]][
                      ivar],(RightTeeVector|RightVectorBar)[blah1_,
                      junction]\[RuleDelayed]
                    Effort[blah1[[1]],junction[[1]]][ivar]}]}},{C[__],
          RightVectorBar[junction,blah2_]\[RuleDelayed]
            Sequence@@{Equal[
                  Displacement[junction[[1]],blah2[[1]]][ivar]/junction[[2]],
                  Effort[junction[[1]],blah2[[1]]][ivar]],
                Displacement[junction[[1]],blah2[[1]]]'[ivar]\[Equal]
                  Flow[junction[[1]],blah2[[1]]][ivar]},
          RightTeeVector[blah1_,junction]\[RuleDelayed]
            Sequence@@{Equal[
                  Displacement[blah1[[1]],junction[[1]]][ivar]/junction[[2]],
                  Effort[blah1[[1]],junction[[1]]][ivar]],
                Displacement[blah1[[1]],junction[[1]]]'[
                    ivar]\[Equal]Flow[blah1[[1]],junction[[1]]][
                    ivar]}},{\[ScriptCapitalI][__],
          RightTeeVector[junction,
              blah2_]\[RuleDelayed]Sequence@@{Equal[
                  Momentum[junction[[1]],blah2[[1]]][ivar]/junction[[2]],
                  Flow[junction[[1]],blah2[[1]]][ivar]],
                Momentum[junction[[1]],blah2[[1]]]'[
                    ivar]\[Equal]Effort[junction[[1]],blah2[[1]]][ivar]},
          RightVectorBar[blah1_,
              junction]\[RuleDelayed]Sequence@@{Equal[
                  Momentum[blah1[[1]],junction[[1]]][ivar]/junction[[2]],
                  Flow[blah1[[1]],junction[[1]]][ivar]],
                Momentum[blah1[[1]],junction[[1]]]'[
                    ivar]\[Equal]Effort[blah1[[1]],junction[[1]]][
                    ivar]}},{R[__],(RightTeeVector|RightVectorBar)[junction,
              blah2_]\[RuleDelayed]Equal[
              Effort[junction[[1]],blah2[[1]]][ivar],
              Flow[junction[[1]],blah2[[1]]]*
                junction[[2]][ivar]],(RightTeeVector|RightVectorBar)[blah1_,
              junction]\[RuleDelayed]Equal[
              Flow[blah1[[1]],junction[[1]]][ivar]*junction[[2]],
              Effort[blah1[[1]],junction[[1]]][ivar]]}};
    bonds/.Flatten@
        Cases[nodepatternreplist,
          x_List/;MatchQ[junction,First[x]]\[RuleDelayed]Sequence@@Rest[x]]]



BondGraphEquations[
    PatternTest[bg_,
      BondGraphQ[#,AllowedBonds\[Rule]RightTeeVector|RightVectorBar]&],
    ivar_Symbol]:=
  Module[{eqns=
        And@@Apply[And,
            BondGraphJunctionPatternEqualityReplacements[
                  BondGraphJunctionBonds[bg,#],#,ivar]&/@
              BondGraphJunctions[bg],{1}]},{eqns,
      Cases[Variables[eqns/.Equal|And\[Rule]List],
        x:(Effort|Flow|Displacement|Momentum)[y__][ivar]\[RuleDelayed]
          Head[x]]}]



Options[BondGraphStateEquations]={BondGraphEquationsOutput\[Rule]None};
BondGraphStateEquations[
    PatternTest[bg_,
      BondGraphQ[#,AllowedBonds\[Rule]RightTeeVector|RightVectorBar]&],
    ivar_Symbol,opts___?OptionQ]:=
  Module[{bgrpheqnsout=
        If[(BondGraphEquationsOutput/.{opts}/.Options[
                  BondGraphStateEquations])===None,
          BondGraphEquations[bg,ivar],
          BondGraphEquationsOutput/.{opts}/.Options[BondGraphStateEquations]],
      eqns,vars,elimvars},{eqns,vars}=bgrpheqnsout;
    elimvars=#[ivar]&/@Cases[vars,(Effort|Flow)[__]];{DeleteCases[
        Eliminate[eqns,elimvars],HoldPattern[Unequal[_,0]]],
      Cases[vars,(Displacement|Momentum)[__]]}]





BondGraphAdjacenceTable[bg_?BondGraphQ]:=
  Module[{n,dg},
    TableForm[
      BondGraphAdjacenceMatrix[bg]+
          IdentityMatrix[Length[BondGraphJunctions[bg]]]/.{0->" ",1\[Rule]0,
          RightVector->"\[RightVector]",RightTeeVector\[Rule]"\[RightTeeVector]",
          RightVectorBar\[Rule]"\[RightVectorBar]"},
      TableHeadings\[Rule]
          BondGraphJunctions/@{bg,bg}/.Pattern[n,_][dg__]/;
            Or[n\[Equal]SE,n\[Equal]C,n\[Equal]SF,n\[Equal]\[ScriptCapitalI],
              n\[Equal]R]\[RuleDelayed]n[First@{dg}],
      TableSpacing\[Rule]{1,1}]]



BondGraphUndirectedAdjacenceTable[bg_?BondGraphQ]:=
  Module[{n,dg},
    TableForm[
      BondGraphUndirectedAdjacenceMatrix[bg]+
          IdentityMatrix[Length[BondGraphJunctions[bg]]]/.{0->" ",1\[Rule]0,
          RightVector->"\[RightVector]",RightTeeVector\[Rule]"\[RightTeeVector]",
          RightVectorBar\[Rule]"\[RightVectorBar]",LeftVector->"\[LeftVector]",
          LeftTeeVector\[Rule]"\[LeftTeeVector]",
          LeftVectorBar\[Rule]"\[LeftVectorBar]"},
      TableHeadings\[Rule]
          BondGraphJunctions/@{bg,bg}/.Pattern[n,_][dg__]/;
            Or[n\[Equal]SE,n\[Equal]C,n\[Equal]SF,n\[Equal]\[ScriptCapitalI],
              n\[Equal]R]\[RuleDelayed]n[First@{dg}],
      TableSpacing\[Rule]{1,1}]]



BondGraphUndirectedAdjacenceCountTable[bg_?BondGraphQ]:=
  Module[{n,dg,blah},
    TableForm[
      BondGraphUndirectedAdjacenceCountMatrix[bg]+
          blah IdentityMatrix[Length[BondGraphJunctions[bg]]]/.{0->" ",
          blah\[Rule]0},
      TableHeadings\[Rule]
          BondGraphJunctions/@{bg,bg}/.Pattern[n,_][dg__]/;
            Or[n\[Equal]SE,n\[Equal]C,n\[Equal]SF,n\[Equal]\[ScriptCapitalI],
              n\[Equal]R]\[RuleDelayed]n[First@{dg}],
      TableSpacing\[Rule]{1,1}]]



UnitVector[vec_List]:=vec/Norm[vec];



Perpendicular[s_List,e_List]:=
  UnitVector[Most[Cross[Append[e-s,0],Append[Table[0,{Length[s]}],1]]]]/;
    Length[s]\[Equal]Length[e]



HalfAboveHalfBelow[center_List,vec_List]={center+vec/2,center-vec/2};



BondGraphGraphicsRightTee[s_List,e_List,featlen_?NumericQ]:=
  Line[HalfAboveHalfBelow[s,featlen Perpendicular[s,e]]]



BondGraphGraphicsRightBar[s_List,e_List,featlen_?NumericQ]:=
  Line[HalfAboveHalfBelow[e,featlen Perpendicular[s,e]]]



BondGraphGraphicsRightVector[s_List,e_List,featlen_?NumericQ]:=
  Line[{s,e,e+featlen UnitVector[s+Norm[e-s] Perpendicular[s,e]-e] Sqrt[2]/2}]



BondGraphGraphicsBondStyleFunction[bgadjmat_?MatrixQ,bondlenfrac_?NumericQ,
    featlenfrac_?NumericQ,os:{__?NumericQ},oe:{__?NumericQ},i_Integer,
    j_Integer]:=
  Module[{bondlength,bondcenter,s,e,featlen},bondlength=Norm[oe-os];
    bondcenter=Plus[oe,os]/2;{e,s}=
      HalfAboveHalfBelow[bondcenter,bondlenfrac (oe-os)];
    featlen=bondlength*bondlenfrac*featlenfrac;{BondGraphGraphicsRightVector[
        s,e,featlen],
      Which[bgadjmat[[i,j]]===RightTeeVector,
        BondGraphGraphicsRightTee[s,e,featlen],
        bgadjmat[[i,j]]===RightVectorBar,
        BondGraphGraphicsRightBar[s,e,featlen],True,ReleaseHold@Hold[]]}]



Options[BondGraphPlot]={Method->"LayeredDrawing",BondLengthRatio\[Rule].5,
      FeatureLengthRatio\[Rule].175,ImageSize\[Rule]Automatic};
BondGraphPlot[bg_?BondGraphQ,opts___?OptionQ]:=
  Module[{bgadjmat=BondGraphAdjacenceMatrix[bg],
      bgjunctions=BondGraphJunctions[bg],
      bondlenfrac=BondLengthRatio/.{opts}/.Options[BondGraphPlot],
      featlenfrac=FeatureLengthRatio/.{opts}/.Options[BondGraphPlot],coords,
      labels},coords=
      GraphCoordinates[bg[[1]]/.{$AllowedBonds\[Rule]Rule},
        Method\[Rule](Method/.{opts}/.Options[BondGraphPlot])];
    labels=BondGraphJunctions[bg];
    GraphPlot[bg[[1]]/.{$AllowedBonds\[Rule]Rule},
      EdgeStyleFunction\[Rule]
        Function[
          BondGraphGraphicsBondStyleFunction[bgadjmat,bondlenfrac,featlenfrac,
            coords[[#1]],coords[[#2]],#1,#2]],
      VertexStyleFunction\[Rule]({Text[labels[[#]],#]}&),
      VertexCoordinates\[Rule]coords,
      ImageSize\[Rule](ImageSize/.{opts}/.Options[BondGraphPlot])]]



End[];



EndPackage[];























